home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / simcode.arc / DIREAD.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-19  |  4KB  |  121 lines
  1. {$symtab-,$pagesize:84,$linesize:96,$debug-,
  2. $title:'DIREAD.PAS -- read and display a directory'}
  3. {       COPYRIGHT @ 1984
  4.         Jim & Eric Holtman
  5.         35 Dogwood Trail
  6.         Randolph, NJ 07869
  7.         (201) 361-3395
  8. }
  9.  
  10.  module diread;
  11.  
  12.     function dosxqq(comm, parm : word): byte;
  13.  
  14.        external;
  15.  
  16.     procedure putchar(inchar : char);
  17.  
  18.        external;
  19.  
  20.     procedure print_dir;
  21.  
  22.        type
  23.           symtabptr = ^symtab;
  24.  
  25.           symtab = record
  26.              sym_name : string(13);
  27.              sym_next : symtabptr;
  28.              end;
  29.  
  30.           dta_type = record
  31.              reserved : string(20);
  32.              attribute : byte;
  33.              time : word;
  34.              date : word;
  35.              size : array[0..1] of integer;
  36.              name : string(13);
  37.              end;
  38.  
  39.        var
  40.           crcxqq [external]: word;
  41.           dta : dta_type;
  42.           fs: lstring(100);
  43.           i,j,q : integer;
  44.           err : byte;
  45.           top,lptr,nptr : symtabptr;
  46.  
  47.        procedure cleanup;          {delete all entries on the chain}
  48.  
  49.           begin
  50.              lptr := top;
  51.              repeat
  52.                 nptr := lptr^.sym_next;
  53.                 dispose(lptr);
  54.                 lptr := nptr;
  55.                 until lptr = nil;
  56.              end;
  57.  
  58.        begin
  59.           new(top);
  60.           top^.sym_name := chr(0)*'            ';
  61.                                    {low}
  62.           new(top^.sym_next);
  63.           top^.sym_next^.sym_name := chr(#FF)*'            ';
  64.                                    {high}
  65.           top^.sym_next^.sym_next := nil;
  66.           write('Directory/Pattern (full path): ');
  67.           readln(fs);
  68.           if fs = '\' then fs := null;
  69.           if (positn('*',fs,1)>0) or (positn('?',fs,1)>0) then concat(fs,chr(0))
  70.           else concat(fs,'\*.*'*chr(0));
  71.           eval(dosxqq(#1A,wrd(adr dta)));
  72.           crcxqq := 0;
  73.           err := dosxqq(#4E, wrd(adr fs) + 1);
  74.           if err=3 then begin
  75.              writeln('Path not found');
  76.              cleanup;
  77.              return;
  78.              end;
  79.           putchar(chr(10));
  80.           putchar(chr(13));
  81.           while err <> 18 do begin
  82.              j := scaneq(13,chr(0),dta.name,1);
  83.                                    {find the end of the string}
  84.              for q := j+1 to 13 do dta.name[q] := ' ';
  85.                                    {pad with blanks}
  86.              lptr := top;          {search the list for a place to put the name}
  87.              nptr := lptr^.sym_next;
  88.              while nptr <> nil do begin
  89.                 if nptr^.sym_name > dta.name then begin
  90.                                    {location found}
  91.                    new(nptr);      {allocate the block}
  92.                    nptr^.sym_name := dta.name;
  93.                                    {init the variables}
  94.                    nptr^.sym_next := lptr^.sym_next;
  95.                                    {insert into chain}
  96.                    lptr^.sym_next := nptr;
  97.                    nptr := nil;
  98.                    end
  99.                 else begin
  100.                    lptr := nptr;
  101.                    nptr := nptr^.sym_next;
  102.                    end;
  103.                 end;
  104.              err := dosxqq(#4F,0); {next matching entry}
  105.              end;
  106.           i := 0;
  107.           nptr := top^.sym_next;   {print out the sorted files}
  108.           while nptr <> nil do begin
  109.              for j := 1 to 13 do putchar(nptr^.sym_name[j]);
  110.              i := i+1;
  111.              if (i mod 6) = 0 then begin
  112.                 putchar(chr(10));
  113.                 putchar(chr(13));
  114.                 end;
  115.              nptr := nptr^.sym_next;
  116.              end;
  117.           putchar(chr(10));
  118.           putchar(chr(13));
  119.           cleanup;
  120.           end;   end.
  121.